home *** CD-ROM | disk | FTP | other *** search
/ Shareware Super Platinum 8 / Shareware Super Platinum 8.iso / mac / WIN_PRO / DS-1.ZIP;1 / RUNTIME.ZIP / LMISC.R < prev    next >
Encoding:
Text File  |  1992-02-10  |  3.6 KB  |  173 lines
  1. /*
  2.  * file: lmisc.r
  3.  *   Contents: [O]create, activate
  4.  */
  5.  
  6. /*
  7.  * create - return an entry block for a co-expression.
  8.  */
  9. #if COMPILER
  10. struct b_coexpr *create(fnc, cproc, ntemps, wrk_size)
  11. continuation fnc;
  12. struct b_proc *cproc;
  13. int ntemps;
  14. int wrk_size;
  15. #else                    /* COMPILER */
  16.  
  17. Ocreate(entryp, cargp)
  18. word *entryp;
  19. register dptr cargp;
  20. #endif                    /* COMPILER */
  21.    {
  22.  
  23. #ifdef Coexpr
  24.    tended struct b_coexpr *sblkp;
  25.    register struct b_refresh *rblkp;
  26.    register dptr dp, ndp;
  27.    int na, nl, i;
  28.  
  29. #if !COMPILER
  30.    struct b_proc *cproc;
  31.  
  32.    /* cproc is the Icon procedure that create occurs in */
  33.    cproc = (struct b_proc *)BlkLoc(argp[0]);
  34. #endif                    /* COMPILER */
  35.  
  36.    /*
  37.     * Calculate number of arguments and number of local variables.
  38.     */
  39. #if COMPILER
  40.    na = abs(cproc->nparam);
  41. #else                    /* COMPILER */
  42.    na = pfp->pf_nargs + 1;  /* includes Arg0 */
  43. #endif                    /* COMPILER */
  44.    nl = (int)cproc->ndynam;
  45.  
  46.    /*
  47.     * Get a new co-expression stack and initialize.
  48.     */
  49.  
  50.    Protect(sblkp = alccoexp(), err_msg(0, NULL));
  51.  
  52.  
  53.    if (!sblkp)
  54. #if COMPILER
  55.       return NULL;
  56. #else                    /* COMPILER */
  57.       Fail;
  58. #endif                    /* COMPILER */
  59.  
  60.    /*
  61.     * Get a refresh block for the new co-expression.
  62.     */
  63. #if COMPILER
  64.    Protect(rblkp = alcrefresh(na, nl, ntemps, wrk_size), err_msg(0,NULL));
  65. #else                    /* COMPILER */
  66.    Protect(rblkp = alcrefresh(entryp, na, nl),err_msg(0,NULL));
  67. #endif                    /* COMPILER */
  68.    if (!rblkp)
  69. #if COMPILER
  70.       return NULL;
  71. #else                    /* COMPILER */
  72.       Fail;
  73. #endif                    /* COMPILER */
  74.  
  75.    sblkp->freshblk.dword = D_Refresh;
  76.    BlkLoc(sblkp->freshblk) = (union block *) rblkp;
  77.  
  78. #if !COMPILER
  79.    /*
  80.     * Copy current procedure frame marker into refresh block.
  81.     */
  82.    rblkp->pfmkr = *pfp;
  83.    rblkp->pfmkr.pf_pfp = 0;
  84. #endif                    /* COMPILER */
  85.  
  86.    /*
  87.     * Copy arguments into refresh block.
  88.     */
  89.    ndp = rblkp->elems;
  90.    dp = argp;
  91.    for (i = 1; i <= na; i++)
  92.       *ndp++ = *dp++;
  93.  
  94.    /*
  95.     * Copy locals into the refresh block.
  96.     */
  97. #if COMPILER
  98.    dp = pfp->tend.d;
  99. #else                    /* COMPILER */
  100.    dp = &(pfp->pf_locals)[0];
  101. #endif                    /* COMPILER */
  102.    for (i = 1; i <= nl; i++)
  103.       *ndp++ = *dp++;
  104.  
  105.    /*
  106.     * Use the refresh block to finish initializing the co-expression stack.
  107.     */
  108.    co_init(sblkp);
  109.  
  110. #if COMPILER
  111.    sblkp->fnc = fnc;
  112.    if (line_info) {
  113.       if (debug_info)
  114.          PFDebug(sblkp->pf)->proc = cproc;
  115.       PFDebug(sblkp->pf)->old_fname = "";
  116.       PFDebug(sblkp->pf)->old_line = 0;
  117.       }
  118.  
  119.    return sblkp;
  120. #else                    /* COMPILER */
  121.    /*
  122.     * Return the new co-expression.
  123.     */
  124.    Arg0.dword = D_Coexpr;
  125.    BlkLoc(Arg0) = (union block *) sblkp;
  126.    Return;
  127. #endif                    /* COMPILER */
  128. #else                    /* Coexpr */
  129.    err_msg(401, NULL);
  130. #if COMPILER
  131.    return NULL;
  132. #else                    /* COMPILER */
  133.    Fail;
  134. #endif                    /* COMPILER */
  135. #endif                    /* Coexpr */
  136.  
  137.    }
  138.  
  139. /*
  140.  * activate - activate a co-expression.
  141.  */
  142. int activate(val, ncp, result)
  143. dptr val;
  144. struct b_coexpr *ncp;
  145. dptr result;
  146.    {
  147. #ifdef Coexpr
  148.  
  149.    int first;
  150.  
  151.    /*
  152.     * Set activator in new co-expression.
  153.     */
  154.    if (ncp->es_actstk == NULL) {
  155.       Protect(ncp->es_actstk = alcactiv(),RunErr(0,NULL));
  156.       first = 0;
  157.       }
  158.    else
  159.       first = 1;
  160.  
  161.    if (pushact(ncp, (struct b_coexpr *)BlkLoc(k_current)) == Error)
  162.       RunErr(0,NULL);
  163.  
  164.    if (co_chng(ncp, val, result, A_Coact, first) == A_Cofail)
  165.       return A_Resume;
  166.    else
  167.       return A_Continue;
  168.  
  169. #else                    /* Coexpr */
  170.    RunErr(401,NULL);
  171. #endif                    /* Coexpr */
  172.    }
  173.